home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / datetime.arc / DATETIME.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-01  |  3.0 KB  |  115 lines
  1. Program Datetime {speak current date and time}
  2. {$I Speech.inc}
  3. type
  4.   DateStr = string[10];
  5.   AnyString=string[80];
  6.   TimeString = string[8];
  7. VAR
  8.   Da,Mo,Yr,Yr2,Sday,Hr,Mn,Sc:INTEGER;
  9.   dummy:datestr;
  10.   Nm:AnyString;
  11.   dummy2:timestring;
  12.  
  13. {Function to get date from DOS}
  14. function Date: DateStr;
  15. type
  16.   regpack = record
  17.               ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  18.             end;
  19.  
  20. var
  21.   recpack:       regpack;                {record for MsDos call}
  22.   month,day:     string[2];
  23.   year:          string[4];
  24.   dx,cx:         integer;
  25.  
  26. begin
  27.   with recpack do
  28.   begin
  29.     ax := $2a shl 8;
  30.   end;
  31.   MsDos(recpack);                        { call function }
  32.   with recpack do
  33.   begin
  34.     str(cx,year);                        {convert to string}
  35.     str(dx mod 256,day);                     { " }
  36.     str(dx shr 8,month);                     { " }
  37.   DA:=DX MOD 256;                        {for speech call}
  38.   MO:=DX SHR 8;                              { " }
  39.   yr:=cx;                                    { " }
  40.   yr2:=cx-1900;                              { " }
  41.   end;
  42.   date := month+'/'+day+'/'+year;
  43.  
  44. end;
  45.  
  46. {Function to get time from DOS}
  47. function time: TimeString;
  48. type
  49.   regpack = record
  50.               ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  51.             end;
  52.  
  53. var
  54.   recpack:          regpack;             {assign record}
  55.   ah,al,ch,cl,dh:   byte;
  56.   hour,min,sec:     string[2];
  57.  
  58. begin
  59.   ah := $2c;                             {initialize correct registers}
  60.   with recpack do
  61.   begin
  62.     ax := ah shl 8 + al;
  63.   end;
  64.   intr($21,recpack);                     {call interrupt}
  65.   with recpack do
  66.   begin
  67.     str(cx shr 8,hour);                  {convert to string}
  68.     str(cx mod 256,min);                       { " }
  69.     str(dx shr 8,sec);                         { " }
  70.     HR:=CX SHR 8;                        {for speech call}
  71.     MN:=CX MOD 256;                            { " }
  72.   end;
  73.   time := hour+':'+min+':'+sec;
  74. end;
  75.  
  76. {procedure to determine day of week - from PC mag 4/14/87}
  77. procedure Zellers_Formula(var mm,dd,yy,vday:integer);
  78. var century, tmp:integer;
  79. begin
  80.   if mm <3 then mm:=mm+10
  81.            else mm:=mm-2;
  82.   if mm>10 then yy:=yy-1;
  83.   century:= yy div 100;
  84.   yy:=yy mod 100;
  85.   tmp:=trunc(2.6*mm-0.2)+dd+yy+(yy div 4)+(century div 4)-(2*century);
  86.   vday:=(tmp+777) mod 7;
  87. end;{Zellers_Formula}
  88.  
  89. begin
  90.   dummy:=date;                            {Call date function}
  91.   Zellers_Formula(mo,da,yr,sday);         {get day of week}
  92.   speech('t-oo-d-a-a   ih-s   ');         {Call speech.inc}
  93.   DAYSPEECH(sday+1);
  94.   speech('   ');
  95.   mo:=mo+2;
  96.   MONSPEECH(MO);
  97.   NUMdaySPEECH(DA);
  98.   NUMSPEECH(19);
  99.   NUMSPEECH(yr2);
  100.  
  101.   dummy2:=time;                           {Call time function}
  102.   IF HR >=13 THEN
  103.    NM:='  P-EE  EH-M'
  104.    ELSE
  105.    NM:='  A-EE  EH-M';
  106.    if hr>=13 then HR:=HR-12;
  107.    if hr=0 then hr:=12;
  108.    if hr=0 then nm:='  A-EE  EH-M';
  109.   speech('          ih-t  ih-s  n-ae-w   ');
  110.   NUMSPEECH(HR);
  111.   NUMSPEECH(MN);
  112.   SPEECH(NM);
  113.   clrscr;
  114. end.
  115.